home *** CD-ROM | disk | FTP | other *** search
/ Mac Magazin/MacEasy 52 / Mac Magazin and MacEasy Magazine CD - Issue 52.iso / Updates / Stata 5.0 Ado-files / ado.sea / newado / reshape.ado < prev    next >
Text File  |  1998-11-22  |  28KB  |  1,421 lines
  1. *! version 4.0.3  13aug1998
  2. program define reshape
  3.     version 5.0
  4.  
  5.     if "`1'"=="clear" { 
  6.         char _dta[ReS_ver]
  7.         char _dta[ReS_i]
  8.         char _dta[ReS_j]
  9.         char _dta[ReS_jv]
  10.         char _dta[ReS_Xij]
  11.         char _dta[Res_Xi]
  12.         char _dta[ReS_atwl]
  13.         char _dta[ReS_str]
  14.         exit
  15.     }
  16.  
  17.     if "`1'"=="wide" | "`1'"=="long" { 
  18.         DoNew `*'
  19.         exit
  20.     }
  21.  
  22.     local syntax : char _dta[ReS_ver]
  23.  
  24.     if "`1'"=="" | "`1'"==substr("query",1,length("`1'")) { 
  25.         if "`syntax'"=="" | "`syntax'"=="v.2" {
  26.             Query 
  27.             exit
  28.         }
  29.         local 1 "query"
  30.     }
  31.         
  32.     if "`syntax'"=="" { 
  33.         IfOld `1'
  34.         if $S_1 {
  35.             DoOld `*'
  36.             char _dta[ReS_ver] "v.1"
  37.         }
  38.         else {
  39.             DoNew `*'
  40.             char _dta[ReS_ver] "v.2"
  41.         }
  42.         exit
  43.     }
  44.  
  45.     if "`syntax'"=="v.1" {
  46.         DoOld `*'
  47.     }
  48.     else     DoNew `*'
  49. end
  50.  
  51. program define IfOld
  52.     if "`1'"=="" {
  53.         global S_1 0
  54.         exit 
  55.     }
  56.     local l = length("`1'")
  57.     if "`1'"==substr("groups",1,`l') | /*
  58.     */ "`1'"==substr("vars",1,`l') | /*
  59.     */ "`1'"==substr("cons",1,`l') | /* 
  60.     */ "`1'"==substr("query",1,`l') { 
  61.         global S_1 1
  62.         exit
  63.     }
  64.     global S_1 0 
  65. end
  66.  
  67. program define IfNew
  68.     if "`1'"=="i" | "`1'"=="j" | "`1'"=="xij" | "`1'"=="xi" | /*
  69.     */ "`1'"=="error" { 
  70.         global S_1 1
  71.     }
  72.     else    global S_1 0
  73. end
  74.  
  75. program define DoNew
  76.     local c "`1'"
  77.     mac shift
  78.         
  79.     if "`c'"=="i" {
  80.         if "`*'" == "" { error 198 }
  81.         unabbrev `*', max(10) min(1)
  82.         char _dta[ReS_i] "$S_1"
  83.         exit
  84.     }
  85.  
  86.  
  87.     if "`c'"=="j" {
  88.         J `*'
  89.         exit
  90.     }
  91.  
  92.     if "`c'"=="xij" {
  93.         Xij `*'
  94.         exit
  95.     }
  96.  
  97.     if "`c'"=="xi" {
  98.         if "`*'"=="" {
  99.             global S_1
  100.         }
  101.         else    unabbrev `*'
  102.         char _dta[Res_Xi] "$S_1"
  103.         exit
  104.     }
  105.  
  106.     if "`c'"=="" {                /* reshape         */
  107.         Query 
  108.         exit
  109.     }
  110.  
  111.     if "`c'"=="long" {            /* reshape long        */
  112.         if "`1'" != "" { 
  113.             Simple long `*'
  114.         }
  115.         capture noisily Long `*'
  116.         Macdrop
  117.         exit _rc
  118.     }
  119.  
  120.  
  121.     if "`c'"=="wide" {            /* reshape wide        */
  122.         if "`1'" != "" { 
  123.             Simple wide `*'
  124.         }
  125.         capture noisily Wide `*'
  126.         Macdrop
  127.         exit _rc
  128.     }
  129.  
  130.     if "`c'"==substr("error",1,max(3,length("`c'"))) { 
  131.         capture noisily Qerror `*'
  132.         Macdrop
  133.         exit
  134.     }
  135.  
  136.     IfOld `c'
  137.     if $S_1 { 
  138.         di in red "may not mix old and new syntax."
  139.         di in red "either use new syntax or " /*
  140.         */ _quote "reshape clear" _quote /*
  141.         */ " and start over using old syntax."
  142.         exit 198
  143.     }
  144.     error 198
  145. end
  146.  
  147. program define Macdrop
  148.     mac drop ReS_j ReS_jv ReS_i ReS_Xij rVANS Res_Xi /*
  149.     */ ReS_atwl ReS_str S_1 S_2
  150. end
  151.  
  152. program define ReportL /* old_obs old_vars */
  153.     Report1 `1' `2' wide long
  154.  
  155.     local n : word count $ReS_jv
  156.     di in gr "j variable (`n' values)" _col(43) "->" _col(48) /*
  157.     */ in ye "$ReS_j"
  158.     di in gr "xij variables:"
  159.     parse "$ReS_Xij", parse(" ")
  160.     while "`1'"!="" { 
  161.         RepF "`1'"
  162.         local skip = 39 - length("$S_1")
  163.         di in ye _skip(`skip') "$S_1" _col(43) in gr "->" /*
  164.         */ in ye _col(48) "$S_2"
  165.         mac shift
  166.     }
  167.     di in gr _dup(77) "-"
  168. end
  169.  
  170. program define RepF /* element from ReS_Xij */
  171.     local v "`1'"
  172.     if "$ReS_jv2" != "" { 
  173.         local n : word count $ReS_jv2
  174.         parse "$ReS_jv2", parse(" ")
  175.     }
  176.     else {    
  177.         local n : word count $ReS_jv
  178.         parse "$ReS_jv", parse(" ")
  179.     }
  180.     if `n'>=1 {
  181.         Subname `v' `1'
  182.         local list $S_1
  183.     }
  184.     if `n'>=2 { 
  185.         Subname `v' `2'
  186.         local list `list' $S_1
  187.     }
  188.     if `n'==3 {
  189.         Subname `v' ``n''
  190.         local list `list' $S_1
  191.     }
  192.     else if `n'>3 {
  193.         Subname `v' ``n''
  194.         local list `list' ... $S_1
  195.     }
  196.     Subname `v' $ReS_atwl
  197.     global S_2 $S_1
  198.     global S_1 `list'
  199. end
  200.     
  201.  
  202. program define Report1 /* <#oobs> <#ovars> {wide|long} {long|wide} */
  203.     local oobs "`1'"
  204.     local ovars "`2'"
  205.     local wide "`3'"
  206.     local long "`4'"
  207.  
  208.     di _n in gr "Data" _col(36) "`wide'" _col(43) "->" _col(47) "`long'" /*
  209.     */ _n _dup(77) "-"
  210.  
  211.     di in gr "Number of obs." _col(32) in ye %8.0g `oobs' /* 
  212.     */ in gr _col(43) "->" in ye %8.0g _N
  213.  
  214.     quietly desc, short
  215.  
  216.     di in gr "Number of variables" _col(32) in ye %8.0g `ovars' /* 
  217.     */ in gr _col(43) "->" in ye %8.0g _result(2)
  218. end
  219.  
  220. program define ReportW /* old_obs old_vars */
  221.     Report1 `1' `2' wide long
  222.  
  223.     local n : word count $ReS_jv2
  224.     local col = 31+(9-length("$ReS_j"))
  225.     di in gr "j variable (`n' values)" /* 
  226.         */ _col(`col') in ye "$ReS_j" in gr _col(43) "->" /*
  227.         */ _col(48) "(dropped)"
  228.     di in gr "xij variables:"
  229.     parse "$ReS_Xij", parse(" ")
  230.     while "`1'"!="" { 
  231.         RepF "`1'"
  232.         local skip = 39 - length("$S_2")
  233.         di in ye _skip(`skip') "$S_2" _col(43) in gr "->" /*
  234.         */ in ye _col(48) "$S_1"
  235.         mac shift
  236.     }
  237.     di in gr _dup(77) "-"
  238. end
  239.  
  240.  
  241.  
  242.  
  243.  
  244. program define Simple /* {wide|long} <funnylist>, i(varlist) 
  245.                     [j(varname [values])] */
  246.     local cmd "`1'"
  247.     mac shift
  248.     parse "`*'", parse(" ,") 
  249.     while "`1'"!="" & "`1'"!="," { 
  250.         local list `list' `1'
  251.         mac shift
  252.     }
  253.     if "`list'"=="" { 
  254.         error 198 
  255.     }
  256.     if "`1'" != "," { 
  257.         di in red "option i() required"
  258.         exit 198 
  259.     }
  260.     local options "I(string) J(string) ATwl(string) String"
  261.     parse "`*'"
  262.     if "`i'"=="" {
  263.         di in red "option i() required"
  264.         exit 198
  265.     }
  266.     unabbrev `i'
  267.     local i $S_1
  268.  
  269.     if "`j'" != "" { 
  270.         parse "`j'", parse(" ") 
  271.         local jvar "`1'"
  272.         mac shift 
  273.         local jvals "`*'"
  274.     }
  275.     else     local jvar "_j"
  276.  
  277.     if "`cmd'"=="wide" { 
  278.         capture confirm var `jvar'
  279.         if _rc { 
  280.             if _rc==111 {
  281.                 di in red "`jvar' not found -- " _c
  282.                 if "`jvar'"=="_j" {
  283.                     di in red "specify j() option"
  284.                 }
  285.                 else    di in red "data already wide"
  286.                 exit 111
  287.             }
  288.             confirm var `jvar'
  289.             exit 198    /* just in case */
  290.         }
  291.     }
  292.     else {
  293.         capture confirm new var `jvar'
  294.         if _rc { 
  295.             if _rc==110 { 
  296.                 di in red /* 
  297.             */ "`jvar' already defined -- data already long"
  298.                 exit 110
  299.             }
  300.             confirm new var `jvar' 
  301.             exit 198    /* just in case */
  302.         }
  303.     }
  304.  
  305.     if "`atwl'"!="" {
  306.         local atwl "atwl(`atwl')"
  307.     }
  308.     if "`string'" != "" {
  309.         local string ", string"
  310.     }
  311.  
  312.     
  313.     reshape clear 
  314.     reshape i `i'
  315.     reshape j `jvar' `jvals' `string'
  316.     reshape xij `list' `atwl'
  317. end
  318.  
  319. program define Xij /* <names-maybe-with-@>[, atwl(string) */
  320.     if "`*'"=="" { error 198 } 
  321.     parse "`*'", parse(" ,")
  322.     while "`1'" != "" & "`1'"!="," {
  323.         local list "`list' `1'"
  324.         mac shift 
  325.     }
  326.     if "`list'"=="" { 
  327.         error 198 
  328.     }
  329.     local list `list'
  330.     if "`1'"=="," { 
  331.         local options "ATwl(string)"
  332.         parse "`*'"
  333.     }
  334.     char _dta[ReS_Xij] "`list'"
  335.     char _dta[ReS_atwl] "`atwl'"
  336. end
  337.  
  338. program define DoOld
  339.     local c "`1'"
  340.     local l = length("`c'")
  341.     mac shift
  342.  
  343.     if "`c'"==substr("groups",1,`l') {
  344.         if "`2'" == "" { 
  345.             error 198 
  346.         }
  347.         DoNew j `*'
  348.         exit
  349.     }
  350.     if "`c'"==substr("vars",1,`l') { 
  351.         DoNew xij `*'
  352.         exit
  353.     }
  354.     if "`c'"==substr("cons",1,`l') { 
  355.         DoNew i `*'
  356.         exit
  357.     }
  358.     if "`c'"==substr("query",1,`l') { 
  359.         local cons   : char _dta[ReS_i]
  360.         local grpvar : char _dta[ReS_j]
  361.         local values : char _dta[ReS_jv]
  362.         local vars   : char _dta[ReS_Xij]
  363.         local car    : char _dta[Res_Xi]
  364.         di "group var:  `grpvar'"
  365.         di "values:     `values'"
  366.         di "cons:       `cons'"
  367.         di "vars:       `vars'"
  368.         exit
  369.     }
  370.     if "`c'"=="wide" { 
  371.         DoNew wide `*'
  372.         exit
  373.     }
  374.     if "`c'"=="long" { 
  375.         DoNew long `*'
  376.         exit
  377.     }
  378.     IfNew `c'
  379.     if $S_1 { 
  380.         di in red "may not mix old and new syntax."
  381.         di in red "either use old syntax or " /*
  382.         */ _quote "reshape clear" _quote /*
  383.         */ " and start over using new syntax."
  384.         exit 198
  385.     }
  386.     error 198
  387. end
  388.         
  389.  
  390.  
  391. program define Query
  392.     if "`*'"!="" { 
  393.         error 198
  394.     }
  395.     local cons   : char _dta[ReS_i]
  396.     local grpvar : char _dta[ReS_j]
  397.     local values : char _dta[ReS_jv]
  398.     local vars   : char _dta[ReS_Xij]
  399.     local car    : char _dta[Res_Xi]
  400.     local atwl   : char _dta[ReS_atwl]
  401.     local isstr  : char _dta[ReS_str]
  402.  
  403.     if "`grpvar'"!="" { 
  404.         capture confirm var `grpvar'
  405.         if _rc { 
  406.             di _n in ye " (data is wide)"
  407.         }
  408.         else    di _n in ye " (data is long)"
  409.     }
  410.     else    di
  411.  
  412.     if "`cons'"=="" { 
  413.         local ccons "in gr"
  414.         local cons "<varlist>"
  415.     }
  416.  
  417.     if "`grpvar'"=="" { 
  418.         local cgrpvar "in gr"
  419.         local grpvar "<varname>"
  420.         if "`values'"=="" { 
  421.             local values "[<#> - <#>]"
  422.         }
  423.     }
  424.     else if `isstr' {
  425.         local values "`values', string"
  426.     }
  427.  
  428.     if "`vars'"=="" { 
  429.         local cvars "in gr"
  430.         local vars "<varnames-without-#j-suffix>"
  431.     }
  432.     else {
  433.         if "`atwl'" != "" { 
  434.             local vars "`vars', atwl(`atwl')"
  435.         }
  436.     }
  437.     if "`car'"=="" {
  438.         local ccar "in gr"
  439.         local car "<varlist>"
  440.     }
  441.  
  442.     di in gr "+" _dup(77) "-" "+" _n /*
  443.     */ "| Xij" _col(32) "| Command/contents" _col(79) "|" _n /*
  444.     */ in gr "+" _dup(30) "-" "+" _dup(46) "-" "+"
  445.  
  446.     di in gr "| Subscript i,j definitions:" _col(32) "|" _col(79) "|"
  447.  
  448.     di in gr "|  group id variable(s)" _col(32) "| reshape i " _c 
  449.     Qlist 44 "`ccons'" `cons'
  450.  
  451.     di in gr "|  within-group variable" _col(32) "| reshape j " _c
  452.     Qlist 44 "`cgrpvar'" `grpvar' `values'
  453.     di in gr "|   and its range" _col(32) "|" _col(79) "|"
  454.  
  455.     di in gr "|" _col(32) "|" _col(79) "|"
  456.  
  457.     di in gr "| Variable X definitions:" _col(32) "|" _col(79) "|"
  458.  
  459.     di in gr "|  varying within group" _col(32) "| reshape xij " _c
  460.     Qlist 46 "`cvars'" `vars'
  461.  
  462.     di in gr "|  constant within group (opt) | reshape xi  " _c
  463.     Qlist 46 "`ccar'" `car'
  464.  
  465.     di in gr "+" _dup(77) "-" "+"
  466.  
  467.     local cons   : char _dta[ReS_i]
  468.     local grpvar : char _dta[ReS_j]
  469.     local values : char _dta[ReS_jv]
  470.     local vars   : char _dta[ReS_Xij]
  471.     local car    : char _dta[Res_Xi]
  472.  
  473.     if "`cons'"=="" {
  474.         di in gr "First type " _quote in white /*
  475.         */ "reshape i" in gr _quote /*
  476.         */ " to define the i variable."
  477.         exit
  478.     }
  479.     if "`grpvar'"=="" {
  480.         di in gr "Type " _quote in wh /*
  481.         */ "reshape j" in gr _quote /* 
  482.         */ " to define the j variable and, optionally, values."
  483.         exit
  484.     }
  485.     if "`vars'"=="" { 
  486.         di in gr "Type " _quote in wh /*
  487.         */ "reshape xit" in gr _quote /*
  488.         */ " to define variables that vary within i."
  489.         exit
  490.     }
  491.     if "`car'"=="" { 
  492.         di in gr /*
  493.     */ "Optionally type " _quote in wh "reshape xi" in gr _quote /*
  494.     */ " to define variables that are constant within i."
  495.     }
  496.     capture confirm var `grpvar'
  497.     if _rc { 
  498.         di in gr "Type " _quote in wh "reshape long" in gr _quote /*
  499.         */ " to convert the data to long form."
  500.         exit
  501.     }
  502.     di in gr "Type " _quote in wh "reshape wide" in gr _quote /*
  503.         */ " to convert the data to wide form."
  504. end
  505. program define Qlist /* col <optcolor> stuff */
  506.     local col `1'
  507.     local clr "`2'"
  508.     mac shift 2
  509.     while "`1'" != "" { 
  510.         local l = length("`1'")
  511.         if `col' + `l' + 1 >= 79 { 
  512.             local skip = 79 - `col' 
  513.             di in gr _skip(`skip') "|" _n /*
  514.             */ "|" _col(32) "| " _c
  515.             local col 34
  516.         }
  517.         di in ye `clr' "`1' " _c
  518.         local col = `col' + `l' + 1
  519.         mac shift
  520.     }
  521.     local skip = 79 - `col' 
  522.     di in gr _skip(`skip') "|"
  523. end
  524.  
  525. program define Qerror
  526.     Macros
  527.     Macros2 preserve
  528.     capture confirm var $ReS_j
  529.     if _rc==0 { 
  530.         QerrorW
  531.     }
  532.     else    QerrorL
  533. end
  534.  
  535.  
  536. /* ------------------------------------------------------------------------ */
  537. program define Wide        /* reshape wide */
  538.     local oldobs = _N
  539.     quietly describe, short
  540.     local oldvars = _result(2)
  541.  
  542.     Macros 
  543.     capture confirm var $ReS_j
  544.     if _rc { 
  545.         di in blu "(already wide)"
  546.         exit
  547.     }
  548.     confirm var $ReS_j $rVANS $ReS_i $Res_Xi
  549.     capture confirm var _merge
  550.     if _rc ==0 { 
  551.         di in red "cannot convert data containing variable _merge;"
  552.         di in red "drop or rename _merge"
  553.         exit 110
  554.     }
  555.  
  556.     preserve
  557.     Macros2
  558.     if $S_1 {
  559.         restore, preserve
  560.     }
  561.     confirm var $ReS_j $Res_Xi
  562.  
  563.     Veruniq
  564.  
  565. /*
  566.     Organization:
  567.         dataset dscons:        (may not exist)
  568.             $ReS_i        (1 obs per $ReS_i)
  569.             $Res_Xi
  570.  
  571.         dataset dsvars:
  572.             $ReS_i        (many obs per $ReS_i)
  573.             $ReS_j
  574.             $ReS_Xij
  575.  
  576.         dataset dsnew:
  577.             $ReS_i        (1 obs per $ReS_i)
  578.             <widened $VARS>
  579.             <$Res_Xi>
  580.  
  581.     Note, ("`dscons'"!="") == ("$ReS_i"!="")
  582. */
  583.  
  584.     tempfile dsnew dsvars hold
  585.     if "$Res_Xi" != "" {
  586.         tempfile dscons
  587.     }
  588.     quietly {
  589.         keep $ReS_j $rVANS $ReS_i $Res_Xi
  590.         sort $ReS_i $ReS_j
  591.         if "`dscons'"!="" {
  592.             save "`dscons'", replace    /* temporarily */
  593.             drop $Res_Xi
  594.             save "`dsvars'", replace
  595.             use "`dscons'", clear
  596.         }
  597.         else    save "`dsvars'", replace
  598.  
  599.         by $ReS_i: keep if _n==1
  600.         if "`dscons'"!="" {
  601.             keep $ReS_i $Res_Xi
  602.             save "`dscons'", replace
  603.         }
  604.         keep $ReS_i
  605.         save "`dsnew'", replace
  606.  
  607.     /* datasets initialized, now step through each value: */
  608.  
  609.         globa ReS_jv2
  610.         parse "$ReS_jv", parse(" ")
  611.         while "`1'" != "" {
  612.             use "`dsvars'", clear
  613.             if $ReS_str {
  614.                 keep if $ReS_j=="`1'"
  615.             }
  616.             else     keep if $ReS_j == `1'
  617.             if _N==0 { 
  618.                 noi di in bl /*
  619.                 */ "(note:  no data for $ReS_j == `1')"
  620.                 capture use "`dsnew'", replace
  621.             }
  622.             else { 
  623.                 global ReS_jv2 $ReS_jv2 `1'
  624.                 drop $ReS_j
  625.                 noisily Widefix `1'
  626.                 save "`hold'", replace 
  627.                 use "`dsnew'", clear
  628.                 merge $ReS_i using "`hold'"
  629.                 drop _merge 
  630.                 sort $ReS_i
  631.                 save "`dsnew'", replace
  632.             }
  633.             mac shift 
  634.         }
  635.         if "`dscons'" != "" {
  636.             merge $ReS_i using "`dscons'"
  637.             drop _merge 
  638.         }
  639.     }
  640.     global S_FN
  641.     global S_FNDATE
  642.     if "`syntax'" != "v.1" {
  643.         sort $ReS_i
  644.     }
  645.     restore, not
  646.  
  647.     local syntax: char _dta[ReS_ver]
  648.     if "`syntax'" != "v.1" {
  649.         ReportW `oldobs' `oldvars'
  650.     }
  651. end
  652.  
  653. program define Veruniq 
  654.     sort $ReS_i $ReS_j
  655.     capture by $ReS_i $ReS_j: assert _N==1
  656.     if _rc { 
  657.         di in red "$ReS_j not unique within $ReS_i;"
  658.         di in red /*
  659.         */ "there are multiple observations at the same $ReS_j" /*
  660.         */ " within $ReS_i."
  661.         di in red "Type " _quote "reshape error" _quote /* 
  662.         */ " for a listing of the problem observations."
  663.         exit 9
  664.     }
  665.     if "$Res_Xi"=="" {
  666.         exit
  667.     }
  668.     sort $ReS_i $Res_Xi $ReS_j
  669.     tempvar cnt1 cnt2
  670.     quietly by $ReS_i: gen long `cnt1' = _N
  671.     quietly by $ReS_i $Res_Xi: gen long `cnt2' = _N
  672.     capture assert `cnt1' == `cnt2'
  673.     if _rc==0 { 
  674.         exit 
  675.     }
  676.     parse "$Res_Xi", parse(" ")
  677.     while "`1'"!=""  {
  678.         capture by $ReS_i: assert `1'==`1'[1]
  679.         if _rc { 
  680.             di in red "`1' not constant within $ReS_i"
  681.         }
  682.         mac shift 
  683.     }
  684.     di in red "Type " _quote "reshape error" _quote /* 
  685.         */ " for a listing of the problem observations."
  686.     exit 9
  687. end
  688.  
  689. program define QerrorW
  690.     confirm var $ReS_j $ReS_Xij $ReS_i $Res_Xi
  691.     sort $ReS_i $ReS_j
  692.     capture by $ReS_i $ReS_j: assert _N==1
  693.     if _rc { 
  694.         Msg1
  695.         di in gr /*
  696.     */ "The data are in the long form;  j should be unique within i." _n 
  697.         di in gr /*
  698.         */ "There are multiple observations on the same " /*
  699.         */ in ye "$ReS_j" in gr " within " /*
  700.         */ in ye "$ReS_i" in gr "." _n
  701.  
  702.         tempvar bad 
  703.         quietly by $ReS_i $ReS_j: gen `bad' = _N!=1
  704.         quietly count if `bad'
  705.         di in gr /*
  706.         */ "The following " _result(1) /*
  707.         */ " out of " _N /*
  708.         */ " observations have repeated $ReS_j values:"
  709.         list $ReS_i $ReS_j if `bad'
  710.         di in gr _n "(data now sorted by $ReS_i $ReS_j)"
  711.         exit
  712.     }
  713.     if "$Res_Xi"=="" {
  714.         di in gr "$ReS_j is unique within $ReS_i;"
  715.         di in gr "there is no error with which " /*
  716.         */ _quote "reshape error" _quote " can help."
  717.         exit
  718.     }
  719.     sort $ReS_i $Res_Xi $ReS_j
  720.     tempvar cnt1 cnt2
  721.     quietly by $ReS_i: gen long `cnt1' = _N
  722.     quietly by $ReS_i $Res_Xi: gen long `cnt2' = _N
  723.     capture assert `cnt1' == `cnt2'
  724.     if _rc==0 { 
  725.         di in gr "$ReS_j is unique within $ReS_i and"
  726.         di in gr "all the " _quote "reshape xi" _quote /*
  727.         */ " variables are constant within $ReS_j;"
  728.         di in gr "there is no error with which " /*
  729.         */ _quote "reshape error" _quote " can help."
  730.         exit 
  731.     }
  732.  
  733.     Msg1
  734.     local n : word count $ReS_Xij
  735.     if `n'==1 { 
  736.         di in gr "xij variable is " in ye "$ReS_Xij" in gr "."
  737.     }
  738.     else    di in gr "xij variables are " in ye "$ReS_Xij" in gr "." 
  739.     di in gr "Thus, the following variable(s) should be constant within i:"
  740.     di in ye _col(7) "$Res_Xi"
  741.  
  742.     sort $ReS_i $ReS_j
  743.     tempvar bad
  744.     parse "$Res_Xi", parse(" ")
  745.     while "`1'"!=""  {
  746.         capture by $ReS_i: assert `1'==`1'[1]
  747.         if _rc { 
  748.             qui by $ReS_i: gen long `bad' = /*
  749.                 */ cond(_n==_N,sum(`1'!=`1'[1]),0)
  750.             qui count if `bad'
  751.             di _n in ye "`1'" in gr " not constant within i (" /*
  752.                 */ in ye "$ReS_i" in gr ") for " /* 
  753.                 */ _result(1) " value" _c
  754.             if _result(1)==1 {
  755.                 di in gr " of i:"
  756.             }
  757.             else    di in gr "s of i:"
  758.             qui by $ReS_i: replace `bad' = `bad'[_N]
  759.             list $ReS_i $ReS_j `1' if `bad'
  760.             drop `bad'
  761.         }
  762.         mac shift 
  763.     }
  764.     di in gr _n "(data now sorted by $ReS_i $ReS_j)"
  765. end
  766. program define Msg1
  767.     di _n in gr "i (" in ye "$ReS_i" in gr /*
  768.     */ ") indicates the top-level grouping such as subject id." 
  769.     di in gr "j (" in ye "$ReS_j" in gr /* 
  770.     */ ") indicates the subgrouping such as time."
  771. end
  772.  
  773. /*
  774.     Widefix #
  775.  
  776.     Assumption when called:  currently in memory are single observations
  777.     per $ReS_i coressponding to $ReS_j==#
  778.  
  779.     go through $ReS_Xij and rename each ${ReS_Xij}#
  780. */
  781.     
  782.  
  783. program define Widefix /* # */ /* reshape wide utility */
  784.     local val "`1'"
  785.     parse "$ReS_Xij", parse(" ")
  786.     while "`1'" != "" { 
  787.         Subname `1' `val'
  788.         local new $S_1
  789.         capture confirm new var `new'
  790.         if _rc {
  791.             capture confirm var `new' 
  792.             if _rc {
  793.                 di in red "`new' implied name too long"
  794.                 exit 198
  795.             }
  796.             else {
  797.                 di in red "`new' already defined
  798.                 exit 110
  799.             }
  800.         }
  801.         Subname `1' $ReS_atwl
  802.         rename $S_1 `new' 
  803.         label var `new' "`val' $S_1"
  804.         mac shift 
  805.     }
  806. end
  807. /* ------------------------------------------------------------------------ */
  808.  
  809.  
  810.  
  811. program define Long         /* reshape long */
  812.     local oldobs = _N
  813.     quietly describe, short
  814.     local oldvars = _result(2)
  815.  
  816.     Macros
  817.     confirm var $ReS_i $Res_Xi
  818.     capture confirm new var $ReS_j
  819.     if _rc { 
  820.         di in blu "(already long)"
  821.         exit
  822.     }
  823.     preserve
  824.     Macros2
  825.     if $S_1 {
  826.         restore, preserve
  827.     }
  828.     confirm var $ReS_i $Res_Xi
  829.  
  830.     tempfile new
  831.     Verluniq
  832.     quietly {
  833.         mkrtmpST
  834.         drop _all
  835.         set obs 1 
  836.         if $ReS_str {
  837.             gen str8 $ReS_j = ""
  838.         }
  839.         else    gen float $ReS_j = . 
  840.         save "`new'", replace
  841.         parse "$ReS_jv", parse(" ")
  842.         while "`1'"!="" { 
  843.             restore, preserve
  844.             noisily Longdo `1'
  845.             append using "`new'"
  846.             save "`new'", replace
  847.             mac shift 
  848.         }
  849.         if $ReS_str {
  850.             drop if $ReS_j == "" 
  851.         }
  852.         else    drop if $ReS_j == . 
  853.         global rtmpST
  854.         compress $ReS_j
  855.     }
  856.     global S_FN
  857.     global S_FNDATE
  858.     local syntax: char _dta[ReS_ver]
  859.     if "`syntax'" != "v.1" {
  860.         order $ReS_i $ReS_j 
  861.         sort $ReS_i $ReS_j
  862.     }
  863.     restore, not
  864.  
  865.     if "`syntax'" != "v.1" {
  866.         ReportL `oldobs' `oldvars'
  867.     }
  868. end
  869.  
  870. program define Verluniq
  871.     local id : char _dta[ReS_i]
  872.     sort `id' 
  873.     capture by `id': assert _N==1
  874.     if _rc { 
  875.         di in red "i=`id' does not uniquely identify the observations;"
  876.         di in red "there are multiple observations " /*
  877.         */ "with the same value of `id'."
  878.         di in red "Type " _quote "reshape error" _quote /* 
  879.         */ " for a listing of the problem observations."
  880.         exit 9
  881.     }
  882. end
  883.  
  884. program define QerrorL
  885.     confirm var $ReS_i 
  886.     local id "$ReS_i"
  887.     sort `id'
  888.     tempvar bad 
  889.     quietly by `id': gen byte `bad' = _N!=1
  890.     capture assert `bad'==0
  891.     if _rc==0 { 
  892.         di in gr "`id' is unique; there is no problem on this score"
  893.         exit
  894.     }
  895.     di _n in gr "i (" in ye "`id'" in gr /*
  896.     */ ") indicates the top-level grouping such as subject id." 
  897.     di _n in gr /*
  898. */ "The data are currently in the wide form; there should be be a single" /*
  899.     */ _n "observation per i". 
  900.     quietly count if `bad'
  901.     di _n in gr _result(1) " out of " _N /*
  902.     */ " observations have duplicate i values:"
  903.     list `id' if `bad'
  904.     di in gr _n "(data now sorted by `id')"
  905. end
  906.  
  907. program define mkrtmpST
  908.     global rtmpST
  909.     parse "$ReS_Xij", parse(" ")
  910.     while "`1'" != "" {
  911.         local ct "empty"
  912.         local i 1
  913.         local val : word `i' of $ReS_jv
  914.         while "`val'" != "" {
  915.             Subname `1' `val'
  916.             local van "$S_1"
  917.             capture confirm var `van'
  918.             if _rc==0 {
  919.                 local nt : type `van'
  920.                 Recast "`ct'" `nt'
  921.                 local ct "$S_1"
  922.                 if "`ct'"=="" {
  923. noi di in red "`van' type mismatch with other `1' variables"
  924.                     exit 198
  925.                 }
  926.             }
  927.             else {
  928.                 capture confirm new var `van'
  929.                 if _rc {
  930.                     di in red /*
  931.                     */ "`van' implied name too long"
  932.                     exit 198
  933.                 }
  934.             }
  935.             local i=`i'+1
  936.             local val : word `i' of $ReS_jv
  937.         }
  938.         if "`ct'"=="empty" { 
  939.             local ct "byte"
  940.         }
  941.         global rtmpST "$rtmpST `ct'"
  942.         mac shift
  943.     }
  944. end
  945.  
  946. program define Longdo /* reshape long dolist utility */
  947.     local val "`1'"
  948.     parse "$ReS_Xij", parse(" ")
  949.     local i 1
  950.     while "``i''" != "" {
  951.         Subname ``i'' `val'
  952.         local van "$S_1"
  953.         local vlist "`vlist' `van'"
  954.         local typ : word `i' of $rtmpST
  955.         local novar 1
  956.         capture confirm var `van' 
  957.         if _rc == 0 {
  958.             capture confirm new var `van'
  959.             if _rc { 
  960.                 local novar 0
  961.             }
  962.         }
  963.         if `novar' { 
  964.             di in bl "(note:  `van' not found)"
  965.             if substr("`typ'",1,3)=="str" {
  966.                 quietly gen `typ' `van' = "" 
  967.             }
  968.             else    quietly gen `typ' `van' = . 
  969.         }
  970.         else     recast `typ' `van' 
  971.         local i=`i'+1
  972.     }
  973.     keep $ReS_i $Res_Xi `vlist'
  974.     if $ReS_str {
  975.         qui gen str8 $ReS_j = "`val'"
  976.     }
  977.     else    qui gen float $ReS_j = `val'
  978.     parse "$ReS_Xij", parse(" ")
  979.     while "`1'" != "" { 
  980.         Subname `1' `val'
  981.         local van "$S_1"
  982.         Subname `1' $ReS_atwl
  983.         local nvan "$S_1"
  984.         rename `van' `nvan' 
  985.         label var `nvan'
  986.         mac shift
  987.     }
  988. end
  989.  
  990.  
  991.  
  992. program define Recast /* recast command to maintain precision */
  993.     if "`1'"=="empty" | "`1'"=="`2'" {
  994.         global S_1 "`2'"
  995.         exit
  996.     }
  997.  
  998.     local a "`1'"
  999.     local b "`2'"
  1000.  
  1001.     local aisstr = substr("`a'",1,3)=="str"
  1002.     local bisstr = substr("`b'",1,3)=="str"
  1003.     if `aisstr'!=`bisstr' {
  1004.         global S_1
  1005.         exit
  1006.     }
  1007.  
  1008.     if "`a'"=="byte" {
  1009.         global S_1 "`b'"
  1010.         exit
  1011.     }
  1012.  
  1013.     global S_1 "`a'"
  1014.     if "`a'"=="int" {
  1015.         if "`b'"!="byte" {
  1016.             global S_1 "`b'"
  1017.         }
  1018.         exit
  1019.     }
  1020.     if "`a'"=="long" {
  1021.         if "`b'"!="byte" & "`b'"!="int" {
  1022.             global S_1 "`b'"
  1023.         }
  1024.         exit
  1025.     }
  1026.  
  1027.     if "`a'"=="float" {
  1028.         if "`b'"=="`double'" {
  1029.             global S_1 "`b'"
  1030.         }
  1031.         exit
  1032.     }
  1033.     if "`a'"=="double" { exit }
  1034.  
  1035.     local l1 = real(substr("`a'",4,.))
  1036.     local l2 = real(substr("`b'",4,.))
  1037.     if `l2'>`l1' {
  1038.         global S_1 "`b'"
  1039.     }
  1040. end
  1041.         
  1042.  
  1043. program define J /* reshape j [ #[-#] [...] | <str> <str> ...] [, string] */
  1044.     if "`*'"=="" { 
  1045.         error 198 
  1046.     }
  1047.     parse "`*'", parse(" -,")
  1048.     local grpvar "`1'"
  1049.     mac shift 
  1050.  
  1051.     local isstr 0
  1052.     while "`1'"!="" & "`1'"!="," {
  1053.         if "`2'" == "-" { 
  1054.             local i1 `1'
  1055.             local i2 `3'
  1056.             confirm integer number `i1'
  1057.             confirm integer number `i2'
  1058.             if `i1' >= `i2' {
  1059.                 di in red "`i1'-`i2':  invalid range"
  1060.                 exit 198
  1061.             }
  1062.             while `i1' <= `i2' { 
  1063.                 local values `values' `i1'
  1064.                 local i1 = `i1' + 1
  1065.             }
  1066.             mac shift 3
  1067.         }
  1068.         else {
  1069.             capture confirm integer number `1'
  1070.             local isstr = `isstr' | _rc
  1071.             local values `values' `1'
  1072.             mac shift
  1073.         }
  1074.     }
  1075.  
  1076.     if "`1'"=="," { 
  1077.         local options "String"
  1078.         parse "`*'"
  1079.         if `isstr' & "`string'"=="" { 
  1080.             di in red /* 
  1081. */ "must also specify string option if string values are to be specified"
  1082.             exit 198
  1083.         }
  1084.         if "`string'"!="" {
  1085.             local isstr 1
  1086.         }
  1087.     }
  1088.  
  1089.     Chkj `grpvar' `isstr'
  1090.     char _dta[ReS_j] "`grpvar'"
  1091.     char _dta[ReS_jv] "`values'"
  1092.     char _dta[ReS_str] `isstr'
  1093. end
  1094.  
  1095. program define Chkj /* j whether-string */
  1096.     local grpvar "`1'"
  1097.     local isstr `2'
  1098.  
  1099.     capture confirm var `grpvar'
  1100.     if _rc { exit }
  1101.  
  1102.     capture confirm string var `grpvar'
  1103.     if _rc==0 {
  1104.         if !`isstr' {
  1105.             di in red "`grpvar' is string; specify string option"
  1106.             exit 109
  1107.         }
  1108.     }
  1109.     else {
  1110.         if `isstr' {
  1111.             di in red "`grpvar' is numeric"
  1112.             exit 109
  1113.         }
  1114.     }
  1115. end
  1116.  
  1117.  
  1118.  
  1119. program define Macros    /* reshape macro check utility */
  1120.     global ReS_j : char _dta[ReS_j]
  1121.     global ReS_jv : char _dta[ReS_jv]
  1122.     global ReS_jv2
  1123.     global ReS_i   : char _dta[ReS_i]
  1124.     global ReS_Xij   : char _dta[ReS_Xij]
  1125.     global Res_Xi    : char _dta[Res_Xi]
  1126.     global ReS_atwl   : char _dta[ReS_atwl]
  1127.     global ReS_str  : char _dta[ReS_str]
  1128.     local syntax   : char _dta[ReS_ver]
  1129.  
  1130.     if "$ReS_j"=="" { 
  1131.         if "`syntax'"=="v.1" { 
  1132.             NotDefd "reshape groups"
  1133.         }
  1134.         else    NotDefd "reshape j"
  1135.     }
  1136.  
  1137.     capture confirm var $ReS_j
  1138.     if _rc==0 {
  1139.         Chkj $ReS_j $ReS_str
  1140.         if $ReS_str==0 {
  1141.             capture assert $ReS_j!=.
  1142.             if _rc { 
  1143.                 di in red "$ReS_j contains missing values"
  1144.                 exit 498
  1145.             }
  1146.         }
  1147.         else {
  1148.             capture assert trim($ReS_j)!=""
  1149.             if _rc { 
  1150.                 di in red "$ReS_j contains missing values"
  1151.                 exit 498
  1152.             }
  1153.             capture assert $ReS_j==trim($ReS_j)
  1154.             if _rc {
  1155.                 di in red /*
  1156.                 */ "$ReS_j has leading or trailing blanks"
  1157.                 exit 498
  1158.             }
  1159.         }
  1160.     }
  1161.  
  1162.     if "$ReS_jv"=="" {
  1163.         if "`syntax'"=="v.1" { 
  1164.             NotDefd "reshape groups"
  1165.         }
  1166.     }
  1167.     if "$ReS_i"=="" { 
  1168.         if "`syntax'"=="v.1" { 
  1169.             NotDefd "reshape cons"
  1170.         }
  1171.         else    NotDefd "reshape i"
  1172.     }
  1173.     if "$ReS_Xij"=="" { 
  1174.         if "`syntax'"=="v.1" { 
  1175.             NotDefd "reshape vars"
  1176.         }
  1177.         else    NotDefd "reshape xij"
  1178.     }
  1179.  
  1180.     global rVANS
  1181.     parse "$ReS_Xij", parse(" ")
  1182.     local i 1
  1183.     while "``i''"!="" {
  1184.         Subname ``i'' $ReS_atwl
  1185.         global rVANS "$rVANS $S_1"
  1186.         local i = `i' + 1
  1187.     }
  1188.     global S_1
  1189. end
  1190.  
  1191. program define Macros2 /* [preserve] */ /* returns S_1 */
  1192.     local preserv "`1'"
  1193.                 /* determine whether anything to do    */
  1194.     capture confirm var $ReS_j
  1195.     local islong = (_rc==0)
  1196.     local dovalW 0
  1197.     local dovalL 0
  1198.     local docar 0
  1199.     if "$ReS_jv"=="" {
  1200.         if `islong' {
  1201.             local dovalL 1
  1202.         }
  1203.         else    local dovalW 1
  1204.     }
  1205.     if "$Res_Xi"=="" {
  1206.         local syntax : char _dta[ReS_ver]
  1207.         if "`syntax'"=="v.2" { 
  1208.             local docar 1
  1209.         }
  1210.     }
  1211.  
  1212.     if `dovalL' {
  1213.         FillvalL
  1214.     }
  1215.  
  1216.                 /* nothing to do             */
  1217.     if `dovalW'==0 & `docar'==0 {
  1218.         global S_1 0     /* S_1==0 -> data in memory unchanged     */
  1219.         exit 
  1220.     }
  1221.  
  1222.                 /* convert data to to names        */
  1223.     `preserv'
  1224.     local varlist "req ex"
  1225.     parse "_all"
  1226.     quietly { 
  1227.         drop _all
  1228.         local n : word count `varlist'
  1229.         set obs `n'
  1230.         gen str8 name = ""
  1231.         parse "`varlist'", parse(" ")
  1232.         local i 1
  1233.         while `i' <= `n' { 
  1234.             replace name = "``i''" in `i'
  1235.             local i = `i' + 1
  1236.         }
  1237.     }
  1238.  
  1239.                 /* call Fillval and FillXi as required    */
  1240.     if `dovalW' & `docar' {
  1241.         tempfile dsname
  1242.         quietly save "`dsname'"
  1243.         FillvalW
  1244.         quietly use "`dsname'", clear
  1245.         FillXi `islong'
  1246.     }
  1247.     else if `dovalW' {
  1248.         FillvalW
  1249.     }
  1250.     else     FillXi `islong'
  1251.  
  1252.     global S_1 1
  1253. end
  1254.  
  1255.  
  1256.  
  1257. program define NotDefd /* <message> */
  1258.     di in red _quote "`*'" _quote " not defined"
  1259.     exit 111
  1260. end
  1261.  
  1262. program define FillXi /* {1|0} */ /* 1 if islong currently */
  1263.     local islong `1'
  1264.     quietly { 
  1265.         if `islong' {
  1266.             Dropout name $ReS_j $ReS_i
  1267.             parse "$ReS_Xij", parse(" ")
  1268.             local i 1
  1269.             while "``i''" != "" {
  1270.                 Subname ``i'' $ReS_atwl
  1271.                 drop if name=="$S_1"
  1272.                 local i = `i' + 1
  1273.             }
  1274.         }
  1275.         else {                     /* wide */
  1276.             Dropout name $ReS_j $ReS_i
  1277.             parse "$ReS_Xij", parse(" ")
  1278.             local i 1
  1279.             while "``i''" != "" { 
  1280.                 local j 1
  1281.                 local jval : word `j' of $ReS_jv
  1282.                 while "`jval'"!="" {
  1283.                     Subname ``i'' `jval'
  1284.                     drop if name=="$S_1"
  1285.                     local j = `j' + 1
  1286.                     local jval : word `j' of $ReS_jv
  1287.                 }
  1288.                 local i = `i' + 1
  1289.             }
  1290.         }
  1291.         local i 1 
  1292.         while `i' <= _N { 
  1293.             local nam = name[`i']
  1294.             global Res_Xi $Res_Xi `nam'
  1295.             local i = `i' + 1
  1296.         }
  1297.     }
  1298. end
  1299.  
  1300. program define Dropout /* varname varnames */
  1301.     local name "`1'"
  1302.     local i 2
  1303.     while "``i''"!="" {
  1304.         drop if `name'=="``i''"
  1305.         local i = `i' + 1
  1306.     }
  1307. end
  1308.  
  1309.  
  1310. program define FillvalL
  1311.     Tab $ReS_j
  1312. end
  1313.  
  1314.  
  1315. program define Tab /* varname */
  1316.     local v "`1'"
  1317.     global ReS_jv
  1318.     capture confirm string variable `v'
  1319.     if _rc {
  1320.         tempname rows
  1321.         capture tabulate `v', matrow(`rows')
  1322.         if _rc { 
  1323.             if _rc==1 { exit 1 } 
  1324.             local bad 1
  1325.         }
  1326.         else {
  1327.             capture mat list `rows'
  1328.             local bad = _rc
  1329.         }
  1330.         if `bad' { 
  1331.             /* theoretically cannot happen */
  1332.             di in red "$ReS_j contains all missing values"
  1333.             exit 498
  1334.         }
  1335.         local n = rowsof(`rows')
  1336.         local i 1
  1337.         while `i' <= `n' {
  1338.             local el = `rows'[`i',1]
  1339.             global ReS_jv $ReS_jv `el'
  1340.             local i = `i' + 1
  1341.         }
  1342.     }
  1343.     else {                /* string ReS_j    */
  1344.         quietly {
  1345.             sort `v'
  1346.             tempvar one
  1347.             by `v': gen byte `one' = _n>1
  1348.             sort `one' `v'
  1349.             local i 1
  1350.             while `one'[`i']==0 {
  1351.                 local el = `v'[`i']
  1352.                 global ReS_jv $ReS_jv `el'
  1353.                 local i = `i' + 1
  1354.             }
  1355.         }
  1356.     }
  1357.     di in gr "(note:  j = $ReS_jv)"
  1358. end
  1359.  
  1360. program define FillvalW
  1361.     parse "$ReS_Xij", parse(" ")
  1362.     tempvar u res
  1363.     quietly { 
  1364.         local i 1
  1365.         gen str8 `res' = ""
  1366.         while "``i''" != "" { 
  1367.             local l = index("``i''","@")
  1368.             local l = cond(`l'==0, length("``i''")+1,`l')
  1369.             local lft = substr("``i''",1,`l'-1)
  1370.             local rgt = substr("``i''",`l'+1,.)
  1371.             local rgtl = length("`rgt'")
  1372.             local minl = length("`lft'") + `rgtl'
  1373.             gen byte `u' = length(name)>`minl' & /* 
  1374.                 */ substr(name,1,`l'-1)=="`lft'" & /* 
  1375.                 */ substr(name,-`rgtl',.) == "`rgt'"
  1376. /*
  1377. capture assert `res'=="" if `u'
  1378. if _rc { 
  1379.     di in red "logic error"
  1380. noi list
  1381.     exit 9998
  1382. }
  1383. */
  1384.             replace `res' = substr(name,`l',.) if `u'
  1385.             replace `res' = substr(`res',1,length(`res')-`rgtl') /*
  1386.                 */ if `u'
  1387.             capture assert `res'!="" if `u'
  1388.             if _rc {
  1389.                 di in red "variable `lft'`rgt' already defined"
  1390.                 exit 110
  1391.             }
  1392.             drop `u'
  1393.             local i = `i' + 1
  1394.         }
  1395.         capture assert `res'==""
  1396.         if _rc==0 { 
  1397.             di in red "no xij variables found"
  1398.             exit 111
  1399.         }
  1400.     }
  1401.     if !$ReS_str {
  1402.         tempvar num
  1403.         qui gen float `num' = real(`res') if `res'!=""
  1404.         Tab `num'
  1405.     }
  1406.     else    Tab `res'
  1407. end
  1408.             
  1409.             
  1410. program define Subname /* <name-maybe-with-@> <tosub> */
  1411.     local name "`1'"
  1412.     local sub "`2'"
  1413.     local l = index("`name'","@")
  1414.     local l = cond(`l'==0, length("`name'")+1,`l')
  1415.     local a = substr("`name'",1,`l'-1)
  1416.     local c = substr("`name'",`l'+1,.)
  1417.     global S_1 "`a'`sub'`c'"
  1418. end
  1419.  
  1420. exit
  1421.